#!/usr/bin/perl -w
#
# Classify bounces that arrive at the Linux Counter
# This program will look at bounces, attempt to look at their entries
# in the email database, and update their status to BAD if appropriate.
#
use strict;

use Mail::BounceParser;
use Counter;
use Fcntl;
use Getopt::Long;
use NoteHandler;

use vars qw($parser $tempdir $DEBUG $verbose $file $email $users $notes);
use vars qw(%counts %explain);
$DEBUG = 0;
$tempdir = "/home/counter/email/temp";

GetOptions("debug!" => \$DEBUG,
	   "verbose" => \$verbose);

$verbose = $verbose || $DEBUG;
if (! -d $tempdir) {
    warn "Using tempdir /tmp\n";
    $tempdir = "/tmp";
}



$parser = new Mail::BounceParser;

$parser->output_dir($tempdir);
$parser->output_to_core(20000); # 20 Kbytes incore, else swap

$email = Counter::openfile("email");
$users = Counter::openfile("users");

$notes = new NoteHandler;

my $file;

for $file (@ARGV) {
    $notes->start($file);
    my $didsomethinguseful = 0;
    $verbose && print "Reading $file\n";
    # Because most parts don't have content-lengths, we have to
    # fiddle with the output_to_core based on length...
    if (-s $file > 100000) { # 100 Kbytes
	$DEBUG && warn "$file: Big - doing files\n";
	$parser->output_to_core(20000);
    } else {
	$parser->output_to_core("ALL");
    }
    open(FILE, $file) || die "Unable to open $file\n";
    my $msg = $parser->read(\*FILE) || die "ERR:Parsing msg $file failed\n";
    $verbose && print "$file is a ", ref($msg), "\n";
    my $user;
    if ($msg->bounce_destination() =~ /^errors\+(\d+)\@(aleph\.|)counter.li.org/) {
	my $userid = $1;
	$user = $users->get($userid);
	if (!$user) {
	    $notes->note("is for $userid - record not found");
	    $notes->done("no such user");
	    next;
	}
    } else {
	$notes->note("destination ", $msg->bounce_destination, " is not valid");
	$notes->done("TO is broken");
	next;
    }
    
    my $wheretoputit = "";
    if (!$msg->isbounce()) {
	print "$file is not a bounce\n";
	$notes->done("not a bounce");
    } elsif ($msg->recipients() < 1) {
	print "$file ERR: has no recipients\n";
	$notes->done("no recipients");
    } else {
	my @recips = $msg->recipients();
	my $recip;
	for $recip (@recips) {
	    my $addr = $recip->original_recipient();
	    $addr =~ s/^RFC822; ?//i || warn "$file: no RFC822 prefix on $addr\n";
	    my $arec = $email->get($addr);
	    if (!$arec) {
		warn "$file ", $addr, ": emailrec not found (user ", $user->key(), ")\n";
		$notes->done("address not found");
		next;
	    }
	    if ($recip->type() eq "permfail") {
		if ($arec->{state} eq "bad") {
		    $$arec{level} = "<empty>" if !$$arec{level};
		    warn "$file ", $addr, ": already bad - level $$arec{level}\n";
		    $notes->done("already bad");
		    $wheretoputit = "handled/isbad";
		    ++ $didsomethinguseful;
		    next;
		}
		$arec->setstate("bad", "MAIL",
			 $recip->status() . ": " . $recip->diagnostic());
		$arec->{bouncefile} = $file;
		$DEBUG && print $arec->textform();
		$arec->store();
		$notes->done("update to bad");
		++ $didsomethinguseful;
		$wheretoputit = "handled";
	    } elsif ($recip->type() eq "tempfail") {
		if ($arec->{state} eq "bad" || $arec->{state} eq "tempfail") {
		    $$arec{level} = "<empty>" if !$$arec{level};
		    warn "$file ", $addr, ": already $$arec{state} - level $$arec{level}\n";
		    $notes->done("already $$arec{state}");
		    $wheretoputit = "handled/isbad";
		    ++ $didsomethinguseful;
		    next;
		}
		$arec->setstate("tempfail", "MAIL",
			 $recip->status() . ": " . $recip->diagnostic());
		$arec->{bouncefile} = $file;
		$DEBUG && print $arec->textform();
		$arec->store();
		$notes->done("update to tempfail");
		++ $didsomethinguseful;
		$wheretoputit = "handled";
	    } else {
		$notes->note("$addr: not a permfail");
		$notes->done("not a permfail");
	    }
	}
    }
    if ($didsomethinguseful) {
	$verbose && print "Renaming file $file...";
	if (rename($file, "$wheretoputit/$file")) {
	    $verbose && print "OK\n";
	} else {
	    if ($verbose) {
		print "failed\n";
	    } else {
		warn "Error renaming file $file to $wheretoputit/$file\n";
	    }
	}
    }
}

$notes->report();

